﻿
unit UDlgGetImage;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,VFrames, Vcl.ExtCtrls, Vcl.StdCtrls,Vcl.Buttons,UVonSystemFuns,
//   Vcl.ExtDlgs,
   Clipbrd, Vcl.Menus, Vcl.ExtDlgs,UDrugsInfo_1,UDrugsDB, Data.DB,
  Data.Win.ADODB,UDlgDrugsIn;
type
  TFDlgGetImage = class(TForm)
    PaintBox1: TPaintBox;
    Image1: TImage;
    SavePictureDialog1: TSavePictureDialog;
    Panel1: TPanel;
    btnSave: TBitBtn;
    btnExit: TBitBtn;
    Label1: TLabel;
    eDocName: TEdit;
    Label2: TLabel;
    eNote1: TEdit;
    qAttachment: TADOQuery;
    Query0: TADOQuery;
    btnPlay: TBitBtn;
    procedure btnSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
  private
    { Private declarations }
    fActivated  : boolean;
    fVideoImage : TVideoImage;
    fVideoBitmap: TBitmap;
    FVideoFormat:TStringList;
    procedure OnNewVideoFrame(Sender : TObject; Width, Height: integer; DataPtr: pointer);
  public
    { Public declarations }
    procedure FormToInfo(var Info: TDrugsAttachmentInfo);
  end;

var
  FDlgGetImage: TFDlgGetImage;

implementation

{$region 'FL High speed scanner摄像头格式'}
//0    320*240  (MJPG)
//1    320*240  (MJPG)
//2    320*240  (YUY2)
//3    320*240  (YUY2)
//4    640*480  (MJPG)
//5    640*480  (MJPG)
//6    640*480  (YUY2)
//7    640*480  (YUY2)
//8    800*600  (MJPG)
//9    800*600  (MJPG)
//10    800*600  (YUY2)
//11    800*600  (YUY2)
//12    1024*768  (MJPG)
//13    1024*768  (MJPG)
//14    1024*768  (YUY2)
//15    1024*768  (YUY2)
//16    1280*720  (MJPG)
//17    1280*720  (MJPG)
//18    1280*720  (YUY2)
//19    1280*720  (YUY2)
//20    1280*960  (MJPG)
//21    1280*960  (MJPG)
//22    1280*960  (YUY2)
//23    1280*960  (YUY2)
//24    1600*1200  (MJPG)
//25    1600*1200  (MJPG)
//26    1600*1200  (YUY2)
//27    1600*1200  (YUY2)
//28    1920*1080  (MJPG)
//29    1920*1080  (MJPG)
//30    1920*1080  (YUY2)
//31    1920*1080  (YUY2)
//32    2048*1536  (MJPG)
//33    2048*1536  (MJPG)
//34    2048*1536  (MJPG)
//35    2048*1536  (MJPG)
//36    2048*1536  (YUY2)
//37    2048*1536  (YUY2)
//38    2048*1536  (YUY2)
//39    2048*1536  (YUY2)
//40    2592*1944  (MJPG)
//41    2592*1944  (MJPG)
//42    2592*1944  (YUY2)
//43    2592*1944  (YUY2)
//44    3264*2448  (MJPG)
//45    3264*2448  (MJPG)
//46    3264*2448  (YUY2)
//47    3264*2448  (YUY2)
//48    3672*2754  (MJPG)
//49    3672*2754  (MJPG)
//50    3672*2754  (YUY2)
//51    3672*2754  (YUY2)
{$endregion 'FL High speed scanner摄像头格式'}

{$region 'Integrated Camera摄像头格式'}
//0    320*180  (MJPG)
//1    320*180  (YUY2)
//2    320*180  (RGB )
//3    320*240  (MJPG)
//4    320*240  (YUY2)
//5    320*240  (RGB )
//6    352*288  (MJPG)
//7    352*288  (YUY2)
//8    352*288  (RGB )
//9    424*240  (MJPG)
//10   424*240  (YUY2)
//11   424*240  (RGB )
//12   640*360  (MJPG)
//13   640*360  (YUY2)
//14   640*360  (RGB )
//15   640*480  (MJPG)
//16   640*480  (YUY2)
//17   640*480  (RGB )
//18   848*480  (MJPG)
//19   848*480  (YUY2)
//20   848*480  (RGB )
//21   960*540  (MJPG)
//22   960*540  (YUY2)
//23   960*540  (RGB )
//24   1280*720  (MJPG)
//25   1280*720  (YUY2)
//26   1280*720  (RGB )
{$endregion 'Integrated Camera摄像头格式'}

uses DateUtils, Math, UWarehouseManage;


{$R *.dfm}


procedure TFDlgGetImage.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFDlgGetImage.btnPlayClick(Sender: TObject);
begin
  {$region '打开视频'}
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;

//  fVideoImage.VideoStart('Integrated Camera');
  fVideoImage.VideoStart('FL High speed scanner');
  {$region '读取视频格式并写入列表框'}
//  FVideoImage.GetListOfSupportedVideoSizes(FVideoFormat);
//  ListBox1.Items.Clear;
//  Memo1.Lines.Clear;
//  for i:=0 to FVideoFormat.Count-1 do begin
//    ListBox1.Items.Add(FVideoFormat[i]);
//    Memo1.Lines.Add(FVideoFormat[i]);
//  end;
  {$endregion '读取视频格式并写入列表框'}
//  fVideoImage.SetResolutionByIndex(20);//指定视频格式
//  btnStop.Enabled  := true;
  btnSave.Enabled := true;
  Screen.Cursor := crDefault;
  {$endregion '打开视频'}
end;

procedure TFDlgGetImage.btnSaveClick(Sender: TObject);
VAR
  BMP : TBitmap;
  fname: string;
  SQLString:string;
begin
  BMP := TBitmap.Create;
  BMP.Assign(fVideoBitmap);
  fname:= FDrugsDB.AppPath + 'Temp\Attachment.jpg';
  bmp.SaveToFile(fname);
//  IF SavePictureDialog1.Execute then
//    begin
//      try
//        // Will not save the flipping. Sorry, I'm a lazy guy...
//        BMP.SaveToFile(SavePictureDialog1.FileName);
//      except
//        MessageDlg('Could not save file ' + SavePictureDialog1.FileName + '!', mterror, [mbOK], 0);
//      end;
//    end;
  BMP.Free;
  FDrugsDB.ADOConn.BeginTrans;
  try
    qAttachment.Append;
    qAttachment.FieldByName('InNo').AsString:='';
    qAttachment.FieldByName('InIdx').AsString:='0';
    qAttachment.FieldByName('AttachName').AsString:=EDoCName.Text;
    qAttachment.FieldByName('FileExt').AsString:='.jpg';
    qAttachment.FieldByName('Note').AsString:=ENote1.text;
    qAttachment.Post;
    SQLString:='SELECT * FROM Drug_Attachment WHERE ID='+ qAttachment.FieldByName('ID').AsString ;
    FDrugsDB.OpenSQL(SQLString,Query0);
    Query0.Edit;
    (Query0.FieldByName('Content') as TBlobField).LoadFromFile(FDrugsDB.AppPath + 'Temp\Attachment.jpg');
    Query0.Post;
    FDrugsDB.ADOConn.CommitTrans;
    Application.MessageBox('图片保存完成','提示');
    Exit;
  except
    on E: Exception do begin
      DlgInfo('错误', E.Message);
      FDrugsDB.ADOConn.RollbackTrans;
    end;
  end;
  qAttachment.Close;
  qAttachment.Open;
end;

procedure TFDlgGetImage.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fVideoImage.VideoStop;
  fVideoImage.Free;
end;

procedure TFDlgGetImage.FormCreate(Sender: TObject);
var
  i:integer;
begin
//  PaintBox1.Align := alClient;
//  Image1.Align := alClient;
  Self.Width:=1280;
  Self.Height:=1000;
  fActivated      := false;
  fVideoBitmap    := TBitmap.create;
  // Create instance of our video image class.
  fVideoImage     := TVideoImage.Create;
  // Tell fVideoImage what routine to call when a new video-frame has arrived.
  // (This way we control painting by ourselves)
  fVideoImage.OnNewVideoFrame := OnNewVideoFrame;
//  FVideoFormat:=TStringList.Create();

  {$region '打开视频'}
//  Screen.Cursor := crHourGlass;
//  btnPlay.Enabled := false;
//  Application.ProcessMessages;
//
////  fVideoImage.VideoStart('Integrated Camera');
//  fVideoImage.VideoStart('FL High speed scanner');
//  {$region '读取视频格式并写入列表框'}
//  FVideoImage.GetListOfSupportedVideoSizes(FVideoFormat);
//  ListBox1.Items.Clear;
//  for i:=0 to FVideoFormat.Count-1 do
//    ListBox1.Items.Add(FVideoFormat[i]);
//  {$endregion '读取视频格式并写入列表框'}
//  fVideoImage.SetResolutionByIndex(10);//指定视频格式
//  btnStop.Enabled  := true;
//  btnSave.Enabled := true;
//  Screen.Cursor := crDefault;
  {$endregion '打开视频'}
    qAttachment.SQL.Text:='select * from Drug_Attachment where InNo=''''';
    qAttachment.Close;
    qAttachment.Open;
    btnPlayClick(nil);
end;

procedure TFDlgGetImage.FormShow(Sender: TObject);
var
  i:integer;
begin
  {$region '打开视频'}
//  Screen.Cursor := crHourGlass;
////  btnPlay.Enabled := false;
//  Application.ProcessMessages;
//
////  fVideoImage.VideoStart('Integrated Camera');
//  fVideoImage.VideoStart('FL High speed scanner');
//  {$region '读取视频格式并写入列表框'}
////  FVideoImage.GetListOfSupportedVideoSizes(FVideoFormat);
////  ListBox1.Items.Clear;
////  Memo1.Lines.Clear;
////  for i:=0 to FVideoFormat.Count-1 do begin
////    ListBox1.Items.Add(FVideoFormat[i]);
////    Memo1.Lines.Add(FVideoFormat[i]);
////  end;
//  {$endregion '读取视频格式并写入列表框'}
//  fVideoImage.SetResolutionByIndex(26);//指定视频格式
////  btnStop.Enabled  := true;
//  btnSave.Enabled := true;
//  Screen.Cursor := crDefault;
  {$endregion '打开视频'}
end;

procedure TFDlgGetImage.OnNewVideoFrame(Sender : TObject; Width, Height: integer; DataPtr: pointer);
var
  i, r : integer;
begin
  // Retreive latest video image
  fVideoImage.GetBitmap(fVideoBitmap);


//  PaintBox1.Align := alClient;
//  Paintbox1.Canvas.Draw(0, 0, fVideoBitmap);
  Image1.Align := alClient;
  Image1.Picture.Assign(fVideoBitmap);
end;

procedure TFDlgGetImage.FormToInfo(var Info: TDrugsAttachmentInfo);
begin
  {$region '附件'}
  Info.ID:= 0;
  Info.InIdx:= 0;
  Info.InNo:= '';
  Info.AttachName:= eDocName.Text;
  Info.FileExt:= '.jpg';
  Info.InDate:= Now;
  Info.Status:= '正常';
  Info.Note:= ENote1.Text;
  Info.Inputor:= FDrugsDB.LoginInfo.UserInfo.LoginName;
  {$endregion}
end;
end.
